home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok29 / discopper / backdrop.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  171 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     BackDrop.mod
  3.     :Contents.      Öffnet Screen und BackDrop-Borderless-SmartRefresh-Window
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :Support.      einige Ideen von Pit Burkhardt [pit]
  11.     :History.      V1.2 Preusing 27-Apr-89
  12.     :Bugs.      NTSC: not tested
  13.     :Remark.      Für fast Alles zu gebrauchen, kann auch OverScan!
  14.     :Remark.      Nicht reentrant!
  15. ---------------------------------------------------------------------------*)
  16.  
  17. IMPLEMENTATION MODULE BackDrop;
  18.  
  19. FROM SYSTEM    IMPORT    ADDRESS, ADR;
  20. FROM Arts    IMPORT    TermProcedure, Assert, CurrentLevel;
  21. FROM Exec    IMPORT    execBase;
  22. FROM Graphics    IMPORT    FontFlagSet, FontStyleSet, RastPortPtr, TextAttr,
  23.             ViewModeSet, ViewModes;
  24. FROM Intuition    IMPORT    customScreen, IDCMPFlags, IDCMPFlagSet, NewScreen,
  25.             NewWindow, ScreenFlags, ScreenFlagSet, ScreenPtr,
  26.             WindowFlags, WindowFlagSet, WindowPtr,
  27.             CloseScreen, CloseWindow, MakeScreen, OpenWindow,
  28.             OpenScreen, ShowTitle, RethinkDisplay;
  29.  
  30. (* ============== aus BackDrop.def: ==================
  31. VAR    BdScreen: ScreenPtr;
  32.     BdWindow: WindowPtr;
  33.     BdRp    : RastPortPtr;
  34. ======================================================*)
  35.  
  36.  
  37. CONST
  38.     YSTART = 12; (* win zu screen y *)
  39.  
  40. VAR     NewWin        :NewWindow;
  41.         NewScr        :NewScreen;
  42.         Topaz8Attr    :TextAttr;
  43.         StdHeight,
  44.         LaceHeight    :INTEGER;
  45.     StartLevel    :INTEGER;
  46.  
  47. PROCEDURE CloseBackDrop;
  48. BEGIN
  49.   IF BdWindow<>NIL THEN
  50.     CloseWindow(BdWindow);
  51.     BdWindow:=NIL
  52.   END;
  53.   IF BdScreen<>NIL THEN
  54.     CloseScreen(BdScreen);
  55.     BdScreen:=NIL
  56.   END;
  57. END CloseBackDrop;
  58.  
  59.  
  60. PROCEDURE OpenBackDrop(Depth, Width, Height:INTEGER; Title:ADDRESS);
  61. (* Input.    Depth: Anzahl Bitplanes des Screens
  62.    Input.        falls Depth=6, dann ExtraHalfBrite
  63.    Input.    Width: Breite des Windows und des Screens
  64.    Input.    Height: Höhe des WINDOWS!
  65.    Input.    Title: Addresse des Screen-Titels
  66.    Input.        falls NIL: kein Titel, Screenhöhe = Windowhöhe,
  67.    Input.        sonst Screenhöhe = Windowhöhe+12
  68.    Semantic.    Öffnet Screen und Window, je nach Breite und Höhe wird
  69.    Semantic.    Interlace und/oder HiRes gesetzt. Keine IDCMPs!
  70.    Semantic.    Das Ding kommt MITTIG auf die Glotze! (versuche: 200,50!)
  71. *)
  72. VAR
  73.   MoveX, MoveY: INTEGER;
  74. BEGIN
  75.   MoveX:=0; MoveY:=0;
  76.   WITH NewScr DO
  77.     width:=Width;
  78.     leftEdge:=0; topEdge:=0;
  79.     height:=Height;
  80.     IF Title#NIL THEN INC(height,YSTART) END;
  81.     depth:=Depth;
  82.     detailPen:=0; blockPen:=1;
  83.     viewModes:=ViewModeSet{};
  84.     IF width>320+64 THEN
  85.       INCL(viewModes,hires);
  86.       MoveX:=(width-640)/2
  87.     ELSE
  88.       MoveX:=(width-320)/2;
  89.       IF Depth=6 THEN INCL(viewModes,extraHalfbrite) END;
  90.     END;
  91.     IF height > StdHeight+60 THEN
  92.       INCL(viewModes,lace);
  93.       IF (height<LaceHeight-12) OR (height>LaceHeight+12) THEN
  94.         MoveY:=(height-LaceHeight)/2;
  95.       END;
  96.     ELSE
  97.       IF (height<StdHeight-6) OR (height>StdHeight+6) THEN
  98.         MoveY:=(height-StdHeight)/2;
  99.       END;
  100.     END;
  101.     type:=customScreen;
  102.     font:=ADR(Topaz8Attr);
  103.     defaultTitle:=Title;
  104.     gadgets:=NIL;
  105.     customBitMap:=NIL;
  106.   END; (*WITH*)
  107.   BdScreen:=OpenScreen(NewScr);
  108.   Assert(BdScreen<>NIL,ADR("Konnte BackDropScreen nicht öffnen"));
  109.   WITH BdScreen^.viewPort DO
  110.     DEC(dxOffset,MoveX);
  111.     DEC(dyOffset,MoveY);
  112.   END;
  113.   MakeScreen(BdScreen);
  114.   RethinkDisplay;
  115.  
  116.   WITH NewWin DO
  117.     leftEdge:=0;
  118.     IF Title=NIL THEN
  119.       topEdge:=0;
  120.       ShowTitle(BdScreen,FALSE);
  121.     ELSE
  122.       topEdge:=YSTART
  123.     END;
  124.     width:=Width;
  125.     height:=Height;
  126.     detailPen:=0;
  127.     blockPen:=1;
  128.     idcmpFlags:=IDCMPFlagSet{}; (* erstmal nix *)
  129.     flags:=WindowFlagSet{backDrop, borderless, activate}; (* smartRefresh *)
  130.     title:=NIL;
  131.     type:=customScreen;
  132.     firstGadget:=NIL;
  133.     checkMark:=NIL;
  134.     screen:=BdScreen;
  135.     bitMap:=NIL;
  136.     (* minWidth:=width;  das kann entfallen!
  137.     minHeight:=height;
  138.     maxWidth:=width;
  139.     maxHeight:=height; *)
  140.   END; (*WITH*)
  141.   BdWindow:=OpenWindow(NewWin);
  142.   Assert(BdWindow<>NIL,ADR("konnte Fenster nicht öffnen"));
  143.   BdRp:=BdWindow^.rPort;
  144. END OpenBackDrop;
  145.  
  146. PROCEDURE Cleanup;
  147. BEGIN
  148.   IF CurrentLevel()<=StartLevel THEN
  149.     CloseBackDrop
  150.   END
  151. END Cleanup;
  152.  
  153. BEGIN (* module *)
  154.   IF execBase^.vBlankFrequency=50 THEN
  155.     StdHeight:=256
  156.   ELSE
  157.     StdHeight:=200
  158.   END;
  159.   LaceHeight:=2*StdHeight;
  160.   WITH Topaz8Attr DO
  161.     name:=ADR("topaz.font");
  162.     ySize:=8;
  163.     style:=FontStyleSet{};
  164.     flags:=FontFlagSet{};
  165.   END;
  166.   BdScreen:=NIL;
  167.   BdWindow:=NIL;
  168.   StartLevel:=CurrentLevel();
  169.   TermProcedure(Cleanup);
  170. END BackDrop.mod
  171.